home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2004 #11 / Amiga Plus CD - 2004 - No. 11.iso / AmiSoft / Misc / emu / p-interp.lha / p-interp-0.5 / interpreter.c‾ < prev    next >
Text File  |  2001-06-07  |  52KB  |  2,359 lines
  1. /*
  2.  
  3.   P-Code interpreter (to run the apple pascal system)
  4.   Copyright (C) 2000 Mario Klebsch
  5.  
  6.   This program is free software; you can redistribute it and/or modify
  7.   it under the terms of the GNU General Public License as published by
  8.   the Free Software Foundation; either version 2 of the License, or
  9.   (at your option) any later version.
  10.  
  11.   This program is distributed in the hope that it will be useful,
  12.   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.   GNU General Public License for more details.
  15.  
  16.   You should have received a copy of the GNU General Public License
  17.   along with this program; if not, write to the Free Software
  18.   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19.  
  20.  
  21.   $Log: interpreter.c,v $
  22.   Revision 1.14  2001/06/07 21:18:15  mario
  23.   #include <getopt.h> eingefügt.
  24.  
  25.   Revision 1.13  2001/06/07 18:54:40  mario
  26.   Abschneiden von zu grossen Werten beim STP(Store Packed)-Befehl. Ein
  27.   Bug? im eXamine-Kommando des Filers macht diese Änderung notwendig.
  28.  
  29.   Revision 1.12  2001/06/06 23:00:27  mario
  30.   Anzahl der Elemente beim Compare von Byte- und Word-Arrays
  31.   ist B, nicht UB.
  32.  
  33.   Revision 1.11  2001/05/29 22:52:31  mario
  34.   Quellenangabe für das Programm hinzugefügt
  35.  
  36.   Revision 1.10  2001/05/27 19:02:04  mario
  37.   Opcodes in List() durch Mnemonics ersetzt.
  38.  
  39.   Revision 1.9  2001/05/27 18:59:54  mario
  40.   Code zur Berechnung der Fehlerstelle in XeqError an die verschiedenen
  41.   Konfigurationsmöglichkeiten angepasst.
  42.  
  43.   Revision 1.8  2001/05/27 16:31:46  mario
  44.   Debugger wieder eingebaut.
  45.  
  46.   Revision 1.7  2001/05/27 16:21:48  mario
  47.   - Neue Kommandozeilenoption zum Tracen einer einzigen Prozedur
  48.  
  49.   - Auch beim Disassemblieren  von Segment 0 werden jetzt die
  50.     korrekten Prozedurnamen angezeigt.
  51.  
  52.   Revision 1.6  2001/05/27 16:16:23  mario
  53.   Fehlerbehandlung patcht jetzt MISCINFO
  54.  
  55.   Revision 1.5  2001/05/26 16:51:35  mario
  56.   Diverse Kommentare eingefügt, einige Funktionen umgruppiert.
  57.  
  58.   Revision 1.4  2001/05/26 15:13:29  mario
  59.   Diverse kleine Fehler behoben, fehlende #includes, Labels ohne Statement
  60.   dahinter, ...
  61.  
  62.   Revision 1.3  2001/05/21 20:50:55  mario
  63.   Trace nach stdout implementiert
  64.  
  65.   Revision 1.2  2001/05/20 13:12:02  mario
  66.   CVS-Idents und Logs eingefügt
  67.  
  68.  
  69. */
  70.  
  71. #ident "$Id: interpreter.c,v 1.14 2001/06/07 21:18:15 mario Exp $";
  72.  
  73. #include <assert.h>
  74. #include <stdio.h>
  75. #include <unistd.h>
  76. #include <stdlib.h>
  77. #include <ctype.h>
  78. #include <stdarg.h>
  79. #include <string.h>
  80. #include <setjmp.h>
  81. #include <math.h>
  82. #include <sys/types.h>
  83. #include <sys/stat.h>
  84. #include <sys/time.h>
  85. #include <fcntl.h>
  86. #include <getopt.h>
  87.  
  88. #include "version.h"
  89. #include "psystem.h"
  90. #include "Memory.h"
  91. #include "Stack.h"
  92. #include "Sets.h"
  93. #include "Array.h"
  94. #include "Diskio.h"
  95. #include "Term.h"
  96.  
  97. #include "pcode.h"
  98.  
  99. #undef IXP_COMPATIBILITY
  100. #undef TRACE_TRANSLATE
  101. #define TIME_SCALE    1
  102.  
  103. word DisasmP    (char *Buffer,
  104.          word SegNo,
  105.          word IpcBase,
  106.          word Ipc,
  107.          word JTab,
  108.          word Sp);
  109.  
  110. static FILE    *TraceFile=NULL;
  111. static byte    TraceSeg;
  112. static byte    TraceProc;
  113.  
  114. #define APPLE_HEAP_BOT        0x0804
  115. #define APPLE_KP_TOP        0xfe7c
  116. #define APPLE_SEG0_LOAD_GAP    0x450a
  117. #define APPLE_SYSCOM        0xbdde
  118.  
  119. #ifdef TRACE_TRANSLATE
  120. #define KP_TOP            0xe000
  121. #define HEAP_BOT        0x1000
  122. #else
  123. #define KP_TOP            0xfe80
  124. #define HEAP_BOT        0x0200
  125. #endif
  126.  
  127. #define NUMBER(a)    (sizeof(a)/sizeof(a[0]))
  128.  
  129. typedef struct SegDict
  130. {
  131.   int        UseCount;
  132.   word        OldKp;
  133.   word        Seg;
  134.   word        SegBase;
  135. } SegDict_t;
  136.  
  137. SegDict_t    SegDict[32];
  138.  
  139. #define MS_KP        -1
  140. #define MS_STAT        0
  141. #define MS_DYN        1
  142. #define MS_JTAB        2
  143. #define MS_SEG        3
  144. #define MS_IPC        4
  145. #define    MS_SP        5
  146. #define MS_VAR        5        /* Var-Offset counts from 1.. */
  147. #define MS_FRAME_SIZE    6
  148.  
  149. /* Official P-Machine registers */
  150. word    Sp;
  151. word    Ipc;
  152. word    IpcBase;
  153. word    Seg;
  154. word    JTab;
  155. word    Kp;
  156. word    Mp;
  157. word    Np;
  158. word    Base;
  159.  
  160. word    Syscom;
  161.  
  162. /* Flags */
  163.  
  164. #ifndef WORD_MEMORY
  165. int    AppleCompatibility=0;
  166. #endif
  167.  
  168. /* Additional Bookkeeping */
  169. static word CurrentIpc;
  170. static word BaseMp;
  171. unsigned int    Level=0;
  172. unsigned int    TraceLevel=0;
  173. jmp_buf        ProcessNextInstrunction;
  174.  
  175. #ifdef XXX
  176.  
  177. /* Zwei Funktionen, die früher einmal in Debug-Ausgaben benötigt
  178.    wurden, nun aber nicht mehr aufgerufen werden. Sie sind aber zu
  179.    schade, um schon in /dev/null entsorgt zu werden. */
  180.  
  181. char *PStr(word w)
  182. {
  183.   static char    Buffer[256];
  184.   int        len=MemRdByte(w,0);
  185.   char        *p=Buffer;
  186.   int        i;
  187.  
  188.   for (i=0; i<len; i++)
  189.     *p++=MemRdByte(w, i+1);
  190.   *p++='\0';
  191.   return(Buffer);
  192. }
  193.  
  194. char *MultipleWords(word Addr, word Len)
  195. {
  196.   static char    Buffer[5*256+1];
  197.   char        *p=Buffer;
  198.   while (Len--)
  199.     {
  200.       sprintf(p,",%04x", MemRd(Addr));
  201.       p+=strlen(p);
  202.       Addr=WordIndexed(Addr, 1);
  203.     }
  204.   return(Buffer);
  205. }
  206.  
  207. void CheckCallStack(void)
  208. {
  209.   int i;
  210.   word    p=Mp;
  211.  
  212.   for (i=0;i<Level;i++)
  213.     {
  214.       assert(p);
  215.       p=MemRd(WordIndexed(p, MS_DYN));
  216.     }
  217.   assert(p==(0xb000-4));
  218. }
  219. #endif
  220.  
  221. void warning(char *Msg, ...)
  222. {
  223.   va_list ap;
  224.   char    Buffer[512];
  225.   va_start(ap, Msg);
  226.   vsnprintf(Buffer, sizeof(Buffer), Msg, ap);
  227.   va_end(ap);
  228.   fprintf(stderr,"warning: %s\n", Buffer);
  229.   /*  TraceLevel=0x7fff;*/
  230. }
  231.  
  232. void DumpCore(void)
  233. {
  234.   FILE        *f;
  235.   if ((f=fopen("ucsd.core","w")))
  236.     {
  237.       MemDump(f,0,0xffff);
  238.       fclose(f);
  239.     }
  240.   else
  241.     warning("DumpCore: unable to create core dump");
  242. }
  243.  
  244. void panic(char *Msg, ...)
  245. {
  246.   va_list    ap;
  247.   char        Buffer[512];
  248.  
  249.   TermClose();
  250.   va_start(ap, Msg);
  251.   vsnprintf(Buffer, sizeof(Buffer), Msg, ap);
  252.   va_end(ap);
  253.   fprintf(stderr,"panic: %s\n", Buffer);
  254.   DumpCore();
  255.   abort();
  256. }
  257.  
  258. /* Convert to boolean. */
  259. inline word Boolean(word i)
  260. {
  261.   return(i?1:0);
  262. }
  263.  
  264. void MoveLeft(word Dst, Integer DstOffset,
  265.           word Src, Integer SrcOffset, word Len)
  266. {
  267.   while (Len--)
  268.     MemWrByte(Dst, DstOffset++,MemRdByte(Src, SrcOffset++));
  269. }
  270.  
  271. void MoveRight(word Dst, Integer DstOffset,
  272.            word Src, Integer SrcOffset, word Len)
  273. {
  274.   SrcOffset+=Len;
  275.   DstOffset+=Len;
  276.   while (Len--)
  277.     MemWrByte(Dst, --DstOffset, MemRdByte(Src,--SrcOffset));
  278. }
  279.  
  280. word FetchB(void)
  281. {
  282.   byte b;
  283.   b = MemRdByte(IpcBase, Ipc++);
  284.   if (b&0x80)
  285.     return ( (word)((b&0x7f)<<8) + (word)MemRdByte(IpcBase, Ipc++) );
  286.   else
  287.     return ( (word)b );
  288. }
  289.  
  290. inline word FetchW(void)
  291. {
  292.   word    w;
  293.   w =  MemRdByte(IpcBase, Ipc++);
  294.   w += (MemRdByte(IpcBase, Ipc++)<<8);
  295.   return(w);
  296. }
  297.  
  298. inline word FetchUB(void)
  299. {
  300.   return ( (word)MemRdByte(IpcBase, Ipc++) );
  301. }
  302.  
  303. /* Dereference a self relocating pointer. Self relocating pointers are
  304.    used in the segment dictionary and in procedure activation records. */
  305. static inline word SelfRelPtr(word Addr)
  306. {
  307. #ifdef WORD_MEMORY
  308.   return(Addr-MemRd(Addr)/2);
  309. #else
  310.   return(Addr-MemRd(Addr));
  311. #endif
  312. }
  313.  
  314. /* Returns the number of procedures of a segment */
  315. inline byte SegNumProc(word Seg)
  316. {
  317.   return(MemRd(Seg)>>8);
  318. }
  319.  
  320. /* Return the segment number of a segment */
  321. inline byte SegNumber(word Seg)
  322. {
  323.   return(MemRd(Seg)&0xff);
  324. }
  325.  
  326. /* Returns a pointer to the activation record of a specified procedure
  327.    in a specified segment */
  328. inline word Proc(word Seg, byte ProcNr)
  329. {
  330.   PointerCheck(Seg);
  331.   if ((ProcNr<1) || (ProcNr>SegNumProc(Seg)) )
  332.     panic("Proc: Illegal Procedure Number %d",ProcNr);
  333.   return(SelfRelPtr(WordIndexed(Seg,-ProcNr)));
  334. }
  335.  
  336. /* Returns the procedure number of a procedure */
  337. inline signed char ProcNumber(word JTab)
  338. {
  339.   PointerCheck(JTab);
  340.   return (MemRd(JTab)&0xff);
  341. }
  342.  
  343. /* Returns the lex level of a procedure */
  344. inline signed char ProcLexLevel(word JTab)
  345. {
  346.   PointerCheck(JTab);
  347.   return (MemRd(JTab)>>8);
  348. }
  349.  
  350. /* Returns a pointer to the first instruction of a procedure */
  351. static inline word ProcBase(word JTab)
  352. {
  353.   PointerCheck(JTab);
  354.   return (SelfRelPtr(WordIndexed(JTab,-1)));
  355. }
  356.  
  357. /* Returns the byte offset to the exit code of a procedure. */
  358. inline word ProcExitIpc(word JTab)
  359. {
  360.   PointerCheck(JTab);
  361.   return (MemRd(WordIndexed(JTab,-1))-
  362.       MemRd(WordIndexed(JTab,-2))-2);
  363. }
  364.  
  365. /* Returns the size of the parameters, which are passed to a
  366.    procedure. */
  367. inline word ProcParamSize(word JTab)
  368. {
  369.   PointerCheck(JTab);
  370.   return (MemRd(WordIndexed(JTab,-3)));
  371. }
  372.  
  373. /* Returns the size of the storage a procedure needs for its local
  374.    variables. */
  375. inline word ProcDataSize(word JTab)
  376. {
  377.   PointerCheck(JTab);
  378.   return (MemRd(WordIndexed(JTab,-4)));
  379. }
  380.  
  381. /* Returns a pointer to a local variable. */
  382. inline word LocalAddr(word Offset)
  383. {
  384.   return(WordIndexed(Mp, MS_VAR+Offset));
  385. }
  386.  
  387. /* Returns a pointer to a global variable. */
  388. inline word GlobalAddr(word Offset)
  389. {
  390.   return(WordIndexed(Base,MS_VAR+Offset));
  391. }
  392.  
  393. /* Traverse the static link chain. */
  394. inline word Intermediate(byte Count)
  395. {
  396.   word p;
  397.   for (p=Mp;Count;Count--)
  398.     p=MemRd(WordIndexed(p,MS_STAT));
  399.   return(p);
  400. }
  401.  
  402. /* Returns a pointer to a variable of an enclosing procedure. */
  403. inline word IntermediateAddr(word Offset, byte Count)
  404. {
  405.   return( WordIndexed(Intermediate(Count), MS_VAR+Offset) );
  406. }
  407.  
  408. /* Returns a pointer to a variable in a data segment (a global
  409.    variable in a UNIT) */
  410. inline word ExtendedAddr(word Offset, byte SegNo)
  411. {
  412.   assert(SegNo<NUMBER(SegDict));
  413.   return(WordIndexed(SegDict[SegNo].Seg, Offset));
  414. }
  415.  
  416. /* calculates the target address of a jump operation. Positive
  417.    displacements perform relative jumps, negative displacements are
  418.    used as indices into the jump table. */
  419. word jump(signed char disp)
  420. {
  421.   if (disp >=0)
  422.     return(Ipc+disp);
  423.   disp=-disp;
  424. #ifdef WORD_MEMORY
  425.   return(MemRd(WordIndexed(JTab, -1))+2-
  426.      (MemRd(JTab-disp/2)+disp));
  427. #else
  428.   return(MemRd(WordIndexed(JTab, -1))+2-
  429.      (MemRd(JTab-disp)+disp));
  430. #endif
  431. }
  432.  
  433. /* Calculates the static link pointer for a procedure */
  434. inline word StaticLink(word NewSeg, byte ProcNo)
  435. {
  436.   word NewJTab=Proc(NewSeg, ProcNo);
  437.  
  438.   if (!ProcNumber(NewJTab))
  439.     return(NIL);
  440.   return(Intermediate(ProcLexLevel(JTab)-
  441.               ProcLexLevel(NewJTab)+1));
  442. }
  443.  
  444. /* load a segment. If a data segment is to be loaded, just allocate
  445.    storage on the stack */
  446. void CspLoadSegment(byte SegNo)
  447. {
  448.   assert (SegNo<NUMBER(SegDict));
  449.   if (!SegDict[SegNo].UseCount)
  450.     {
  451.       word SegUnit  = MemRd(SEG_UNIT(SegNo));
  452.       word SegBlock = MemRd(SEG_BLOCK(SegNo));
  453.       word SegSize  = MemRd(SEG_SIZE(SegNo));
  454.  
  455.       assert (!(SegSize&1));
  456.       if (!SegSize)
  457.     XeqError(XNOPROC);
  458.  
  459.       SegDict[SegNo].OldKp=Kp;
  460. #ifdef WORD_MEMORY
  461.       Kp-=SegSize/2;
  462. #else
  463.       Kp-=SegSize;
  464. #endif
  465.       SegDict[SegNo].SegBase=Kp;
  466.       if (SegBlock)            /* if a block number is specified,  */
  467.     {                /* load a code segment.            */
  468.       SegDict[SegNo].Seg=WordIndexed(SegDict[SegNo].OldKp,-1);
  469.       DiskRead(SegUnit, Kp, 0, SegSize, SegBlock);
  470.       if (MemRd(IORSLT))
  471.         XeqError(XSYIOER);
  472.     }
  473.       else                /* it is a Data-Segment            */
  474.     SegDict[SegNo].Seg=WordIndexed(Kp,-1);
  475.     }
  476.   SegDict[SegNo].UseCount++;
  477. }
  478.  
  479. void CspUnloadSegment(byte SegNo)
  480. {
  481.   SegDict[SegNo].UseCount--;
  482.   if (!SegDict[SegNo].UseCount)
  483.     {
  484.       Kp=SegDict[SegNo].OldKp;
  485.       SegDict[SegNo].OldKp = 0;
  486.       SegDict[SegNo].Seg   = 0;
  487.     }
  488. }
  489.  
  490. /* Clear the global directory pointer. */
  491. void ClrGDirP(void)
  492. {
  493.   word GDirP=MemRd(GDIRP);
  494.   if (GDirP!=NIL)
  495.     {
  496.       Np=GDirP;
  497.       MemWr(GDIRP, NIL);
  498.     }
  499. }
  500.  
  501. /* check for a gap between heap and stack */
  502. void StackCheck(void)
  503. {
  504.   if (Np>=Kp)
  505.     {
  506.       MemWr(GDIRP, NIL);
  507.       Kp=0x8000;
  508.       Np=0x6200;
  509.       XeqError(XSTKOVR);
  510.     }
  511. }
  512.  
  513. /* call a procedure. It does build a stack frame for the new procedure
  514.    and sets up all recisters of the p-machine. */
  515. int call(word NewSeg, byte ProcNr, word StaticLink)
  516. {
  517.   word    NewJTab      = Proc(NewSeg, ProcNr);
  518.   word    DataSize  = ProcDataSize(NewJTab);
  519.   word    ParamSize = ProcParamSize(NewJTab);
  520.   word    NewMp      = WordIndexed(Kp, -(DataSize + ParamSize)/2);
  521.  
  522.   if (!ProcNumber(NewJTab))
  523.     {
  524.       ProcessNative(NewJTab);
  525.       return(1);
  526.     }
  527.  
  528.   assert(!(ParamSize&1));
  529.  
  530.   MoveLeft(NewMp, 0, Sp, 0, ParamSize);
  531.   Sp=WordIndexed(Sp,ParamSize/2);
  532.  
  533.   NewMp = WordIndexed(NewMp, -MS_FRAME_SIZE);
  534.   if (ProcLexLevel(NewJTab) <= 0)
  535.     {
  536.       Push(Base);
  537.       Base=NewMp;
  538.       MemWr(STKBASE,Base);
  539.     }
  540.  
  541.   MemWr(WordIndexed(NewMp,MS_KP),   Kp);
  542.   MemWr(WordIndexed(NewMp,MS_STAT), StaticLink);
  543.   MemWr(WordIndexed(NewMp,MS_DYN),  Mp);
  544.   MemWr(WordIndexed(NewMp,MS_JTAB), JTab);
  545.   MemWr(WordIndexed(NewMp,MS_SEG),  Seg);
  546.   MemWr(WordIndexed(NewMp,MS_IPC),  Ipc);
  547.   MemWr(WordIndexed(NewMp,MS_SP),   Sp);
  548.  
  549.   Kp      = WordIndexed(NewMp, -1);    /* Kleiner Hack :-( */
  550.   Mp      = NewMp;
  551.   Seg     = NewSeg;
  552.   JTab    = NewJTab;
  553.   MemWr(LASTMP, Mp);
  554. #ifdef SEG
  555.   MemWr(SEG,    Seg);
  556. #endif
  557. #ifdef JTAB
  558.   MemWr(JTAB,   JTab);
  559. #endif
  560.  
  561.   IpcBase = ProcBase(JTab);
  562.   Ipc     = 0;
  563.   Level++;
  564.   StackCheck();
  565.   return(0);
  566. }
  567.  
  568. void ret(byte n)
  569. {
  570.   word    OldMp=Mp;
  571.   byte    OldSegNo=SegNumber(Seg);
  572.  
  573.   while (n>0)
  574.     Push(MemRd(LocalAddr(n--)));
  575.  
  576.   Kp      = MemRd(WordIndexed(OldMp,MS_KP));
  577.   Mp      = MemRd(WordIndexed(OldMp,MS_DYN));
  578.   JTab    = MemRd(WordIndexed(OldMp,MS_JTAB));
  579.   IpcBase = ProcBase(JTab);
  580.   Seg     = MemRd(WordIndexed(OldMp,MS_SEG));
  581.   Ipc     = MemRd(WordIndexed(OldMp,MS_IPC));
  582.   MemWr(LASTMP, Mp);
  583. #ifdef SEG
  584.   MemWr(SEG,    Seg);
  585. #endif
  586. #ifdef JTAB
  587.   MemWr(JTAB,   JTab);
  588. #endif
  589.  
  590.   if (OldSegNo != SegNumber(Seg))
  591.     if (OldSegNo)            /* Segment 0 wird nicht verwaltet   */
  592.       CspUnloadSegment(OldSegNo);
  593.   Level--;
  594.   StackCheck();
  595. }
  596.  
  597. /* An execution error has occured. Resum executon at segment 2
  598.    procedure 1, the system error handler */
  599. void XeqError(word err)
  600. {
  601.   static int Flag=0;
  602.   word    NewSeg=SegDict[0].Seg;
  603.  
  604.   if (Flag)
  605.     panic("XeqError: recursion");
  606.   Flag++;
  607.  
  608.   MemWr(XEQERR,  err);
  609. #ifdef BOMBPROC
  610.   MemWr(BOMBPROC,  ProcNumber(JTab));
  611. #endif
  612. #ifdef BOMBSEG
  613.   MemWr(BOMBSEG,  SegNumber(Seg));
  614. #endif
  615.  
  616. #if 0
  617. #ifndef WORD_MEMORY
  618.   /* The bytewise interpreter used in Apple Pascal did use Pointers
  619.      for the Ipc. Addinf the Offset to IpcBase id sufficient to
  620.      emulate this behavoir. */
  621.   MemWr(BOMBIPC, IpcBase+CurrentIpc);
  622. #else
  623.   /* In my wordwise interpreter, I do calculate this value in a way,
  624.      that the Apple Pascal error printing routine does print the
  625.      correct result. But, this value for BOMBIPC is not the location
  626.      of the failed instruction. */
  627.   MemWr(BOMBIPC,JTab-MemRd(WordIndexed(JTab,-1))-2+CurrentIpc);
  628. #endif
  629.   MemWr(MISCINFO, MemRd(MISCINFO) & ~(1<<10));
  630. #else
  631.   /* Early versions of Apple Pascal do contain the code to directly
  632.      print this offset.  A bit in system.miscinfo is checked in the
  633.      system error handler to see, wether BOMBIPC does contain a
  634.      pointer or an offset. */
  635.   MemWr(BOMBIPC, CurrentIpc);
  636.   MemWr(MISCINFO, MemRd(MISCINFO) | 1<<10);
  637. #endif
  638.  
  639.   call(NewSeg, 2, BaseMp );
  640.   MemWr(BOMBP,   Mp);
  641.  
  642.   /* This code can be used to anter debugging upon entry of the system
  643.      error handler. It probably is only usefull to debug the system
  644.      error handler. */
  645. #ifdef XXX
  646.   TraceLevel=0x7fff;
  647.   warning ("XeqError(%d)", err);
  648. #endif
  649.   Flag--;
  650.   longjmp(ProcessNextInstrunction, 0);
  651. }
  652.  
  653. /****************************************************************************/
  654. /*                                        */
  655. /*        P-debugger stuff.                        */
  656. /*                                        */
  657.  
  658. /* Dump memory in decimal and in hex. Used to dump the evaluation stack */
  659. void ShowMem(word Start, word End)
  660. {
  661.   for ( ;Start<End; Start=WordIndexed(Start,1))
  662.     fprintf(stderr," %d(%x)",MemRd(Start), MemRd(Start));
  663.   fprintf(stderr,"\n");
  664. }
  665.  
  666. /* Disassemble a procedure */
  667. void List(FILE *out, int SegNo, word JTab)
  668. {
  669.   word    IpcBase=ProcBase(JTab);
  670.   word    Ipc=0;
  671.   char    Buffer[1024];
  672.   fprintf(out, "Params: %d, Vars: %d\n",
  673.      ProcParamSize(JTab)/2,
  674.      ProcDataSize(JTab)/2);
  675.   while (WordIndexed(IpcBase, Ipc/2)<JTab)
  676.     {
  677.       word OpCode=MemRdByte(IpcBase, Ipc);
  678.       sprintf(Buffer,"%d:    ", Ipc);
  679.       Ipc=DisasmP(Buffer+strlen(Buffer), SegNo, IpcBase, Ipc, JTab, 0);
  680.       fprintf(out, "%s\n", Buffer);
  681.       if ( (OpCode==RNP) ||
  682.        (OpCode==RBP) ||
  683.        (OpCode==XIT) )
  684.     return;
  685.     }
  686. }
  687.  
  688. void Debugger(void)
  689. {
  690.   char        prompt[64];
  691.   char        Buffer[256];
  692.   int        from,to;
  693.   char        Buf[10];
  694.   char        *line;
  695.   FILE        *out;
  696.   char        *mode;
  697.   int        (*close_method)(FILE*);
  698.  
  699.   if (Level>TraceLevel)
  700.     return;
  701.   TraceLevel=0x7fff;
  702.  
  703.   DisasmP(Buffer, SegNumber(Seg), IpcBase, Ipc, JTab, Sp);
  704.   snprintf(prompt, sizeof(prompt), "s%d, p%d, %4d:    %s    > ", SegNumber(Seg), ProcNumber(JTab), 
  705.         CurrentIpc, Buffer);
  706.  
  707.   do
  708.     {
  709.       Buffer[0]='\0';
  710.       fprintf(stderr,"%s", prompt);
  711.       fgets(Buffer, sizeof(Buffer)-1, stdin);
  712.  
  713.       close_method = NULL;
  714.       out = NULL;
  715.       line=Buffer;
  716.       while (*line)
  717.     if ( (*line == '|')||  (*line == '>') )
  718.       break;
  719.     else
  720.       line++;
  721.  
  722.       if (*line == '|')
  723.     {
  724.       *line='\0';
  725.       line++;
  726.       while (*line)
  727.         if (isspace(*line))
  728.           line++;
  729.         else
  730.           break;
  731.       out = popen(line, "w");
  732.       close_method = pclose;
  733.     }
  734.       else if (*line == '>')
  735.     {
  736.       *line='\0';
  737.       line++;
  738.       if (*line == '>')
  739.         {
  740.           line++;
  741.           mode="a";
  742.         }
  743.       else
  744.         mode="w";
  745.       while (*line)
  746.         if (isspace(*line))
  747.           line++;
  748.         else
  749.           break;
  750.       out = fopen(line, mode);
  751.       close_method = fclose;
  752.     }
  753.       if (!out)
  754.     {
  755.       close_method = NULL;
  756.       out=stderr;
  757.     }
  758.  
  759.       switch (Buffer[0])
  760.     {
  761.     case 'p':        /* print stack */
  762.       fprintf(stderr,"Stack:");
  763.       ShowMem(Sp,SP_TOP);
  764.       break;
  765.     case 'd':
  766.       switch (sscanf(Buffer, "%10s %x %x", Buf, &from, &to))
  767.         {
  768.           /*
  769.         case 1:
  770.           from=NextDumpAddr;
  771.           */
  772.         case 2:
  773.           to=from+0x80;
  774.         case 3:
  775.           MemDump(out, from,to);
  776.           break;
  777.         default:
  778.           fprintf(stderr,"d <from> [<to>]\n");
  779.         }
  780.       break;
  781.     case 'l':
  782.       {
  783.         int SegNo;
  784.         int ProcNo;
  785.         switch (sscanf(Buffer, "%10s %d %d", Buf, &SegNo, &ProcNo))
  786.           {
  787.           case 2:
  788.         ProcNo=SegNo;
  789.         SegNo=SegNumber(Seg);
  790.           case 3:
  791.         if (SegNo<NUMBER(SegDict))
  792.           {
  793.             CspLoadSegment(SegNo);
  794.             List(out, SegNo, Proc(SegDict[SegNo].Seg, ProcNo));
  795.             CspUnloadSegment(SegNo);
  796.           }
  797.         break;
  798.           default:
  799.         fprintf(stderr,"l [<SegNo>] <ProcNo>\n");
  800.           }
  801.       }
  802.       break;
  803.     case 't':
  804.       {
  805.         word s=Seg;
  806.         word j=JTab;
  807.         word m=Mp;
  808.         word i=Ipc;
  809.         
  810.         while (1)
  811.           {
  812.         word w;
  813.         fprintf(out,"\ns%d, p%d, %4d:\n",
  814.             SegNumber(s), ProcNumber(j), i);
  815.         w=WordIndexed(m, MS_VAR);
  816.         MemDump(out, w,w+ProcParamSize(j)+ProcDataSize(j));
  817.         
  818.         if (ProcLexLevel(j)<0)
  819.           break;
  820.         j = MemRd(WordIndexed(m,MS_JTAB));
  821.         s = MemRd(WordIndexed(m,MS_SEG));
  822.         i = MemRd(WordIndexed(m,MS_IPC));
  823.         m = MemRd(WordIndexed(m,MS_DYN));
  824.           }
  825.       }
  826.       MemDump(out, Kp, 0xb000);
  827.       break;
  828.     case 'v':
  829.       MemDump(out, WordIndexed(Mp,MS_VAR), WordIndexed(Mp,MS_VAR)+ProcDataSize(JTab)+ProcParamSize(JTab));
  830.       break;
  831.     case 'g':
  832.       TraceLevel=0;
  833.       return;
  834.     case 'n':
  835.       TraceLevel=Level;
  836.       return;
  837.     case 'f':
  838.       TraceLevel=Level-1;
  839.       return;
  840.     case 'r':
  841.       fprintf(out,"Sp=%04x, Kp=%04x, Mp=%04x, Base=%04x, Seg=%04x, JTab=%04x, Np=%04x\n",
  842.           Sp, Kp, Mp, Base, Seg, JTab, Np);
  843.       break;
  844.     case 'q':
  845.       if (TraceFile)
  846.         fclose(TraceFile);
  847.       exit(0);
  848.       break;
  849.     }
  850.       if (close_method && out)
  851.     {
  852.       close_method(out);
  853.       close_method=NULL;
  854.       out=NULL;
  855.     }
  856.     } while (Buffer[0]!='\n');
  857. }
  858.  
  859. /****************************************************************************/
  860. /*                                        */
  861. /*        P-tracing stuff.                        */
  862. /*                                        */
  863.  
  864. /* To compare traces with byte and word architecture, this routine
  865.    tries to 'normalize' the value of pointers. Of course, the
  866.    assumtions are not always true, but the diffs get a lot shorter
  867.    using this translation. :-) */
  868. inline word Translate(word Value)
  869. {
  870. #ifdef TRACE_TRANSLATE
  871. #ifdef WORD_MEMORY
  872.   if (Value>KP_TOP)
  873.     ;
  874.   else if (Value>0x8000)
  875.     Value = (Value-KP_TOP)*2+KP_TOP;
  876.   else if (Value>0x7f00)
  877.     ;
  878.   else if (Value >HEAP_BOT)
  879.     Value = (Value-HEAP_BOT)*2+HEAP_BOT;
  880. #endif
  881. #endif
  882.   return(Value);
  883. }
  884.  
  885. void Tracer(void)
  886. {
  887.   char    Buffer[64000];
  888.   char    StackBuf[1024];
  889.   char    *p=StackBuf;
  890.   word  w=Sp;
  891.  
  892.   *p='\0';
  893.   while (w<SP_TOP)
  894.     {
  895.       word Value=MemRd(w);
  896.  
  897.       sprintf(p,"%04x ",Translate(Value));
  898.       p+=strlen(p);
  899.       w=WordIndexed(w,1);
  900.     }
  901.  
  902.   DisasmP(Buffer, MemRd(Seg)&0xff, IpcBase, Ipc, JTab, Sp);
  903.  
  904.   fprintf(TraceFile,"s%d p%d o%d    %s    Stack: %s\n",
  905.       MemRd(Seg)&0xff, MemRd(JTab)&0xff, Ipc, Buffer, StackBuf);
  906.  
  907.   fflush(TraceFile);
  908. }
  909.  
  910. void SetTrace(char *list)
  911. {
  912.   int i,j;
  913.   char *p;
  914.  
  915.   p=strchr(list, ',');
  916.   switch(sscanf(list, "%d,%d", &i, &j))
  917.     {
  918.     case 1:
  919.       TraceProc=i;
  920.       break;
  921.     case 2:
  922.       TraceSeg=i;
  923.       TraceProc=j;
  924.       break;
  925.     default:
  926.       fprintf(stderr,"invalid trace flags\n");
  927.       exit(1);
  928.     }
  929. }
  930.  
  931. /****************************************************************************/
  932. /*                                        */
  933. /*        The P-machine itself.                        */
  934. /*                                        */
  935.  
  936. int AppleHack1(void)
  937. {
  938.   word Save0=Ipc;
  939.  
  940.   if (FetchUB() == 145)                /* NGI */
  941.     {
  942.       word OpCode=FetchUB();
  943.       if (OpCode == 171)            /* SRO */
  944.     {
  945.       word Var=FetchB();            /* Parameter SRO */
  946.       OpCode=FetchUB();
  947.       if ((((OpCode   == 169) &&        /* LDO n */
  948.         (FetchB() == Var)) ||
  949.            ((Var>=1) && (Var<=16) &&
  950.         (OpCode   == 231+Var))) &&    /* SLDO n */
  951.           (FetchUB()  ==   0) &&        /* SLCD    0 */
  952.           (FetchUB()  == 190) )        /* LDB */
  953.         return(1);
  954.     }
  955.       else if (OpCode == 204)            /* STL */
  956.     {
  957.       word Var=FetchB();            /* Parameter STL */
  958.       OpCode=FetchUB();
  959.       if ((((OpCode   == 202) &&        /* LDL  n */
  960.         (FetchB() == Var)) ||
  961.            ((Var>=1) && (Var<=16) &&
  962.         (OpCode   == 215+Var))) &&    /* SLDL n */
  963.           (FetchUB()  ==   0) &&        /* SLCD    0 */
  964.           (FetchUB()  == 190) )        /* LDB */
  965.         return(1);
  966.     }
  967.     }
  968.   Ipc=Save0;
  969.   return(0);
  970. }
  971.  
  972. int AppleHack2(void)
  973. {
  974.   word Save=Ipc;
  975.   word Var;
  976.  
  977.   if ( (FetchUB() == 145) &&        /* NGI */
  978.        (FetchUB() == 171) &&        /* SRO */
  979.        (Var=FetchB()) &&        /* Parameter SRO */
  980.        (FetchUB() == 169) &&        /* LDO n */
  981.        (FetchB()  == Var) &&
  982.        (FetchUB() == 6) &&        /* SLDC 6 */
  983.        (FetchUB() == 192) &&        /* IXP 16,1 */
  984.        (FetchUB() == 16) &&
  985.        (FetchUB() == 1) &&
  986.        (FetchUB() == 186))        /* LDP */
  987.     return(1);
  988.   Ipc=Save;
  989.   return(0);
  990. }
  991.  
  992. void Processor(void)
  993. {
  994.   byte    Opcode;
  995.   word    w;
  996.   float    f;
  997.   register word    p1, p2;
  998.  
  999.   setjmp(ProcessNextInstrunction);
  1000.   for ( ; /* ever */ ; )
  1001.     {
  1002.       /* CheckCallStack(); */
  1003.       if (TraceFile)
  1004.     if (!TraceProc ||
  1005.         ( (TraceProc == ProcNumber(JTab)) &&
  1006.           (TraceSeg  == SegNumber(Seg) ) ) )
  1007.       Tracer();
  1008.  
  1009.       Debugger();
  1010.  
  1011.       CurrentIpc = Ipc;
  1012.       Opcode = FetchUB();        /* fetch next instruction */
  1013.       switch (Opcode)
  1014.     {
  1015.         /* One-word load and stores constant */
  1016.     case SLDC_0:    case SLDC_1:    case SLDC_2:    case SLDC_3:
  1017.     case SLDC_4:    case SLDC_5:    case SLDC_6:    case SLDC_7:
  1018.     case SLDC_8:    case SLDC_9:    case SLDC_10:    case SLDC_11:
  1019.     case SLDC_12:    case SLDC_13:    case SLDC_14:    case SLDC_15:
  1020.     case SLDC_16:    case SLDC_17:    case SLDC_18:    case SLDC_19:
  1021.     case SLDC_20:    case SLDC_21:    case SLDC_22:    case SLDC_23:
  1022.     case SLDC_24:    case SLDC_25:    case SLDC_26:    case SLDC_27:
  1023.     case SLDC_28:    case SLDC_29:    case SLDC_30:    case SLDC_31:
  1024.     case SLDC_32:    case SLDC_33:    case SLDC_34:    case SLDC_35:
  1025.     case SLDC_36:    case SLDC_37:    case SLDC_38:    case SLDC_39:
  1026.     case SLDC_40:    case SLDC_41:    case SLDC_42:    case SLDC_43:
  1027.     case SLDC_44:    case SLDC_45:    case SLDC_46:    case SLDC_47:
  1028.     case SLDC_48:    case SLDC_49:    case SLDC_50:    case SLDC_51:
  1029.     case SLDC_52:    case SLDC_53:    case SLDC_54:    case SLDC_55:
  1030.     case SLDC_56:    case SLDC_57:    case SLDC_58:    case SLDC_59:
  1031.     case SLDC_60:    case SLDC_61:    case SLDC_62:    case SLDC_63:
  1032.     case SLDC_64:    case SLDC_65:    case SLDC_66:    case SLDC_67:
  1033.     case SLDC_68:    case SLDC_69:    case SLDC_70:    case SLDC_71:
  1034.     case SLDC_72:    case SLDC_73:    case SLDC_74:    case SLDC_75:
  1035.     case SLDC_76:    case SLDC_77:    case SLDC_78:    case SLDC_79:
  1036.     case SLDC_80:    case SLDC_81:    case SLDC_82:    case SLDC_83:
  1037.     case SLDC_84:    case SLDC_85:    case SLDC_86:    case SLDC_87:
  1038.     case SLDC_88:    case SLDC_89:    case SLDC_90:    case SLDC_91:
  1039.     case SLDC_92:    case SLDC_93:    case SLDC_94:    case SLDC_95:
  1040.     case SLDC_96:    case SLDC_97:    case SLDC_98:    case SLDC_99:
  1041.     case SLDC_100:    case SLDC_101:    case SLDC_102:    case SLDC_103:
  1042.     case SLDC_104:    case SLDC_105:    case SLDC_106:    case SLDC_107:
  1043.     case SLDC_108:    case SLDC_109:    case SLDC_110:    case SLDC_111:
  1044.     case SLDC_112:    case SLDC_113:    case SLDC_114:    case SLDC_115:
  1045.     case SLDC_116:    case SLDC_117:    case SLDC_118:    case SLDC_119:
  1046.     case SLDC_120:    case SLDC_121:    case SLDC_122:    case SLDC_123:
  1047.     case SLDC_124:    case SLDC_125:    case SLDC_126:    case SLDC_127:
  1048.       Push( Opcode-SLDC_0 );    /* SLDC 0..127 Short LoaD Constant */
  1049.       break;
  1050.     case LDCN:            /* LDCN LoaD Constant Nil */
  1051.       Push( NIL );
  1052.       break;
  1053.     case LDCI:            /* LDCI LoaD Constant Integer */
  1054.       p1=FetchW();
  1055.       if (p1 == 16607)        /* Apple-Hack */
  1056.         if (AppleHack1())
  1057.           Push(4);
  1058.         else
  1059.           Push( p1 );
  1060.       else if (p1 == 16606)
  1061.         if (AppleHack2())
  1062.           Push(Boolean(0));
  1063.         else
  1064.           Push( p1 );
  1065.       else
  1066.         Push( p1 );
  1067.       break;
  1068.  
  1069.             /* One-word load and stores local */
  1070.                     /* SLDL Short LoaD Local 1..16 */
  1071.     case SLDL_1:    case SLDL_2:    case SLDL_3:    case SLDL_4:
  1072.     case SLDL_5:    case SLDL_6:    case SLDL_7:    case SLDL_8:
  1073.     case SLDL_9:    case SLDL_10:    case SLDL_11:    case SLDL_12:
  1074.     case SLDL_13:    case SLDL_14:    case SLDL_15:    case SLDL_16:
  1075.       Push( MemRd( LocalAddr( Opcode-SLDL_1+1 )));
  1076.       break;
  1077.     case LDL:            /* LDL LoaD Local */
  1078.       Push( MemRd( LocalAddr( FetchB() ) ) );
  1079.       break;
  1080.     case LLA:            /* LLA Load Local Addres */
  1081.       Push( LocalAddr( FetchB() ) );
  1082.       break;
  1083.     case STL:            /* STL STore Local */
  1084.       MemWr( LocalAddr( FetchB() ), Pop() );
  1085.       break;
  1086.       
  1087.             /* One-word load and stores global */
  1088.                     /* SLDO Short LoaD glObal word */
  1089.     case SLDO_1:    case SLDO_2:    case SLDO_3:    case SLDO_4:
  1090.     case SLDO_5:    case SLDO_6:    case SLDO_7:    case SLDO_8:
  1091.     case SLDO_9:    case SLDO_10:    case SLDO_11:    case SLDO_12:
  1092.     case SLDO_13:    case SLDO_14:    case SLDO_15:    case SLDO_16:
  1093.       Push( MemRd( GlobalAddr( Opcode-SLDO_1+1 )));
  1094.       break;
  1095.     case LDO:            /* LDO LoaD glObal */
  1096.       Push( MemRd( GlobalAddr( FetchB() )));
  1097.       break;
  1098.     case LAO:            /* LAO Load Address glObal */
  1099.       Push( GlobalAddr( FetchB() ));
  1100.       break;
  1101.     case SRO:            /* SRO StoRe glObal */
  1102.       MemWr( GlobalAddr( FetchB() ), Pop() );
  1103.       break;
  1104.  
  1105.         /* One-word load and stores intermediate */
  1106.     case LOD:            /* LOD LOaD */
  1107.       p1 = FetchUB(); Push( MemRd( IntermediateAddr( FetchB(), p1 )));
  1108.       break;
  1109.     case LDA:            /* LDA LOad Addres */
  1110.       p1 = FetchUB(); Push( IntermediateAddr( FetchB(), p1 ));
  1111.       break;
  1112.     case STR:            /* STR StoRe */
  1113.       p1 = FetchUB(); MemWr( IntermediateAddr( FetchB(), p1 ), Pop());
  1114.       break;
  1115.  
  1116.             /* One-word load and stores indirect */
  1117.                     /* SIND Short INDirect */
  1118.     case SIND_0:    case SIND_1:    case SIND_2:    case SIND_3:
  1119.     case SIND_4:    case SIND_5:    case SIND_6:    case SIND_7:
  1120.       Push( MemRd( WordIndexed( Pop(), Opcode-SIND_0 )));
  1121.       break;
  1122.     case IND:            /* IND INDirect */
  1123.       Push( MemRd( WordIndexed( Pop(), FetchB() )));
  1124.       break;
  1125.     case STO:            /* STO STOre indirect */
  1126.       p1 = Pop(); MemWr( Pop(), p1 );
  1127.       break;
  1128.         
  1129.             /* One-word load and stores indirect */
  1130.     case LDE:            /* LDE LoaD Extended */
  1131.       p1 = FetchUB(); Push( MemRd( ExtendedAddr( FetchB(), p1 )));
  1132.       break;
  1133.     case LAE:            /* LAE Load Addres Extended */
  1134.       p1 = FetchUB(); Push( ExtendedAddr( FetchB(), p1 ));
  1135.       break;
  1136.     case STE:            /* STE STore Extended */
  1137.       p1 = FetchUB(); MemWr( ExtendedAddr( FetchB(), p1 ), Pop() );
  1138.       break;
  1139.                 /* multiple-word loads and stores */
  1140.     case LDC:
  1141.       p1=FetchUB();
  1142.       Ipc=(Ipc+1)&(~1);        /* Nur auf Wortgrenze erlaubt */
  1143. #ifdef WORD_MEMORY
  1144.       w=IpcBase+Ipc/2;
  1145. #else
  1146.       w=IpcBase+Ipc;
  1147. #endif
  1148.       while (p1--)
  1149.         Push( FetchW() );
  1150.       break;
  1151.     case LDM:
  1152.       p1=FetchUB();
  1153.       w=Pop();
  1154.       while (p1--)
  1155.         Push( MemRd( WordIndexed( w, p1 )));
  1156.       break;
  1157.     case STM:
  1158.       p1=FetchUB();
  1159.       w=MemRd(WordIndexed(Sp,p1));
  1160.       while (p1--)
  1161.         {
  1162.           MemWr(w, Pop());
  1163.           w=WordIndexed(w,1);
  1164.         }
  1165.       Pop();
  1166.       break;
  1167.                 /* byte array handling */
  1168.     case LDB:
  1169.       w=Pop(); Push(MemRdByte(Pop(), w));
  1170.       break;
  1171.     case STB:
  1172.       p1=Pop(); w=Pop(); MemWrByte(Pop(), w, p1);
  1173.       break;
  1174.                 /* string handling */
  1175.     case LSA:
  1176.       assert(!(Ipc&1));
  1177.       Push( WordIndexed( IpcBase, Ipc/2 ) );
  1178.       Ipc += FetchUB();
  1179.       break;
  1180.     case SAS:
  1181.       p1=FetchUB();
  1182.       if ((w=Pop())&0xff00)
  1183.         {            /* copy String */
  1184.           byte Len=MemRdByte(w, 0);
  1185.           word Dest=Pop();
  1186.           if (Len>p1)
  1187.         XeqError(XS2LONG);
  1188.           MoveLeft(Dest, 0, w, 0, Len+1);
  1189.         }
  1190.       else
  1191.         {            /* store Char */
  1192.           word Dest=Pop();
  1193.           MemWrByte(Dest, 0, 1);    /* make string of len 1            */
  1194.           MemWrByte(Dest, 1, w);    /* containing char on stack        */
  1195.         }
  1196.       break;
  1197.     case IXS:
  1198.       p1=Pop();  p2=Pop();
  1199.       Push(p2);  Push(p1);
  1200.       if (p1>MemRdByte(p2, 0))
  1201.         XeqError(XINVNDX);
  1202.       break;
  1203.                 /* record and array handling */
  1204.     case MOV:
  1205.       p1=FetchB();
  1206.       {
  1207.         word    Src=Pop();
  1208.         word    Dst=Pop();
  1209.         while (p1--)
  1210.           {
  1211.         MemWr(Dst, MemRd(Src));
  1212.         Dst=WordIndexed(Dst,1);
  1213.         Src=WordIndexed(Src,1);
  1214.           }
  1215.       }
  1216.       break;
  1217.     case INC:
  1218.       Push( WordIndexed( Pop(), FetchB() ) );
  1219.       break;
  1220.     case IXA:
  1221.       w=Pop();
  1222.       Push( WordIndexed( Pop(), w*FetchB() ) );
  1223.       break;
  1224.     case IXP:
  1225.       p1 = FetchUB(); p2 = FetchUB(); w=Pop();
  1226.       Push(WordIndexed(Pop(),w/p1)); /* Address */
  1227.       Push(p2);
  1228.       Push((w%p1)*p2
  1229. #ifdef IXP_COMPATIBILITY
  1230.            *0x101
  1231. #endif
  1232.            );
  1233.       break;
  1234.     case LPA:
  1235.       p1=FetchB();
  1236. #ifdef WORD_MEMORY
  1237.       Push(IpcBase+Ipc/2);
  1238. #else
  1239.       Push(IpcBase+Ipc);
  1240. #endif
  1241.       Ipc+=p1;
  1242.       break;
  1243.     case LDP:
  1244.       {
  1245.         word Offset=Pop()&0xff;
  1246.         word Size=Pop();
  1247.         word Addr=Pop();
  1248.         if (Offset+Size>16)
  1249.           {
  1250.         warning("LDP: Offset(%d)+Size(%d) > Bits per word",
  1251.             Offset, Size);
  1252.         XeqError(XINVNDX);
  1253.           }
  1254.         Push((MemRd(Addr)>>Offset)&((1<<Size)-1));
  1255.       }
  1256.       break;
  1257.     case STP:
  1258.       w=Pop();
  1259.       {
  1260.         word Offset=Pop()&0xff;
  1261.         word Size=Pop();
  1262.         word Addr=Pop();
  1263.         if (Offset+Size>16)
  1264.           {
  1265.         warning("STP: Offset(%d)+Size(%d) > Bits per word",
  1266.             Offset, Size);
  1267.         XeqError(XINVNDX);
  1268.           }
  1269.         w &= (1<<Size)-1;
  1270.         MemWr(Addr, 
  1271.           (MemRd(Addr) & ~(((1<<Size)-1)<<Offset)) | (w<<Offset));
  1272.       }
  1273.       break;
  1274.                 /* TOS arithmetic: integers */
  1275.     case ABI:            /* ABI ABsolute Integer */
  1276.       Push( abs( PopInteger()));
  1277.       break;
  1278.     case ADI:
  1279.       Push( PopInteger() + PopInteger() );
  1280.       break;
  1281.     case NGI:
  1282.       Push( -PopInteger() );
  1283.       break;
  1284.     case SBI:
  1285.       {
  1286.         Integer i=PopInteger();
  1287.         Push( PopInteger()-i );
  1288.       }
  1289.       break;
  1290.     case MPI:
  1291.       Push( PopInteger() * PopInteger() );
  1292.       break;
  1293.     case SQI:
  1294.       {
  1295.         Integer i=PopInteger();
  1296.         Push( i*i );
  1297.       }
  1298.       break;
  1299.     case DVI:
  1300.       {
  1301.         Integer i=PopInteger();
  1302.         if (!i)
  1303.           XeqError(XDIVZER);
  1304.         Push( PopInteger() / i );
  1305.       }
  1306.       break;
  1307.     case MODI:
  1308.       {
  1309.         Integer i=PopInteger(); 
  1310.         if (!i)
  1311.           XeqError(XDIVZER);
  1312.         Push( PopInteger() % i );
  1313.       }
  1314.       break;
  1315.     case CHK:
  1316.       {
  1317.         Integer Upper=PopInteger();
  1318.         Integer Lower=PopInteger();
  1319.         Integer Value=PopInteger();
  1320.         Push(Value);
  1321.         if ( (Value>Upper) || (Value<Lower) )
  1322.           XeqError(XINVNDX);
  1323.       }
  1324.       break;
  1325.     case EQUI:
  1326.       {
  1327.         Integer i=PopInteger();
  1328.         Push ( Boolean ( PopInteger() == i ) );
  1329.       }
  1330.       break;
  1331.     case NEQI:
  1332.       {
  1333.         Integer i=PopInteger();
  1334.         Push ( Boolean ( PopInteger() != i ) );
  1335.       }
  1336.       break;
  1337.     case LEQI:
  1338.       {
  1339.         Integer i=PopInteger();
  1340.         Push ( Boolean ( PopInteger() <= i ) );
  1341.       }
  1342.       break;
  1343.     case LESI:
  1344.       {
  1345.         Integer i=PopInteger();
  1346.         Push ( Boolean ( PopInteger() < i ) );
  1347.       }
  1348.       break;
  1349.     case GEQI:
  1350.       {
  1351.         Integer i=PopInteger();
  1352.         Push ( Boolean ( PopInteger() >= i ) );
  1353.       }
  1354.       break;
  1355.     case GRTI:
  1356.       {
  1357.         Integer i=PopInteger();
  1358.         Push ( Boolean ( PopInteger() > i ) );
  1359.       }
  1360.       break;
  1361.                 /* TOS arithmetic: reals */
  1362.     case FLT:
  1363.       PushReal(PopInteger());
  1364.       break;
  1365.     case FLO:
  1366.       f=PopReal();
  1367.       PushReal(PopInteger());
  1368.       PushReal(f);
  1369.       break;
  1370.     case ABR:
  1371.       PushReal(fabs(PopReal()));
  1372.       break;
  1373.     case ADR:
  1374.       PushReal(PopReal()+PopReal());
  1375.       break;
  1376.     case NGR:
  1377.       PushReal(-PopReal());
  1378.       break;
  1379.     case SBR:
  1380.       f=PopReal();
  1381.       PushReal(PopReal()-f);
  1382.       break;
  1383.     case MPR:
  1384.       PushReal(PopReal()*PopReal());
  1385.       break;
  1386.     case SQR:
  1387.       f=PopReal();
  1388.       PushReal(f*f);
  1389.       break;
  1390.     case DVR:
  1391.       if ((f=PopReal())==0)
  1392.         XeqError(XDIVZER);
  1393.       PushReal(PopReal()/f);
  1394.       break;
  1395.  
  1396.     case EQU:
  1397.       switch(FetchUB())
  1398.         {
  1399.         case 2:
  1400.           f=PopReal(); Push(Boolean( PopReal() == f ));
  1401.           break;
  1402.         case 4:
  1403.           w=Pop(); Push(Boolean(StrCmp(Pop(), w) == 0));
  1404.           break;
  1405.         case 6:
  1406.           Push(Boolean((Pop()&1)==(Pop()&1)));
  1407.           break;
  1408.         case 8:
  1409.           {
  1410.         Set_t Set1;
  1411.         Set_t Set2;
  1412.         SetPop(&Set1);
  1413.         SetPop(&Set2);
  1414.         Push(Boolean(SetCmp(&Set1, &Set2) == 0));
  1415.         break;
  1416.           }
  1417.         case 10:
  1418.           w=Pop(); Push(Boolean(ByteCmp(Pop(), w, FetchB() ) == 0));
  1419.           break;
  1420.         case 12:
  1421.           p1=FetchB();
  1422.           w=Pop();
  1423.           Push(Boolean(WordCmp(Pop(), w, p1) == 0));
  1424.           break;
  1425.         default:
  1426.           XeqError(XNOTIMP);
  1427.         }
  1428.       break;
  1429.     case NEQ:
  1430.       switch(FetchUB())
  1431.         {
  1432.         case 2:
  1433.           f=PopReal(); Push(Boolean( PopReal() != f ));
  1434.           break;
  1435.         case 4:
  1436.           w=Pop(); Push(Boolean(StrCmp(Pop(), w) != 0));
  1437.           break;
  1438.         case 6:
  1439.           Push(Boolean((Pop()&1)!=(Pop()&1)));
  1440.           break;
  1441.         case 8:
  1442.           {
  1443.         Set_t Set1;
  1444.         Set_t Set2;
  1445.         SetPop(&Set1);
  1446.         SetPop(&Set2);
  1447.         Push(Boolean(SetCmp(&Set1, &Set2) != 0));
  1448.         break;
  1449.           }
  1450.         case 10:
  1451.           w=Pop(); Push(Boolean(ByteCmp(Pop(), w, FetchB() ) != 0));
  1452.           break;
  1453.         case 12:
  1454.           p1=FetchB();
  1455.           w=Pop();
  1456.           Push(Boolean(WordCmp(Pop(), w, p1) != 0));
  1457.           break;
  1458.         default:
  1459.           XeqError(XNOTIMP);
  1460.         }
  1461.       break;
  1462.       
  1463.     case LEQ:
  1464.       switch(FetchUB())
  1465.         {
  1466.         case 2:
  1467.           f=PopReal(); Push(Boolean( PopReal() <= f ));
  1468.           break;
  1469.         case 4:
  1470.           w=Pop(); Push(Boolean(StrCmp(Pop(), w) <= 0) );
  1471.           break;
  1472.         case 6:
  1473.           w=Pop()&1; Push(Boolean((Pop()&1) <= w));
  1474.           break;
  1475.         case 8:
  1476.           {
  1477.         Set_t Set1;
  1478.         Set_t Set2;
  1479.         SetPop(&Set1);
  1480.         SetPop(&Set2);
  1481.         Push(Boolean(SetIsSubset(&Set1, &Set2)));
  1482.         break;
  1483.           }
  1484.           break;
  1485.         case 10:
  1486.           w=Pop(); Push(Boolean(ByteCmp(Pop(), w, FetchB()) <= 0));
  1487.           break;
  1488.         default:
  1489.           XeqError(XNOTIMP);
  1490.         }
  1491.       break;
  1492.  
  1493.     case LES:
  1494.       switch(FetchUB())
  1495.         {
  1496.         case 2:
  1497.           f=PopReal(); Push(Boolean( PopReal() < f ));
  1498.           break;
  1499.         case 4:
  1500.           w=Pop(); Push(Boolean(StrCmp(Pop(), w) < 0) );
  1501.           break;
  1502.         case 6:
  1503.           w=Pop()&1; Push(Boolean((Pop()&1) < w));
  1504.           break;
  1505.         case 10:
  1506.           w=Pop(); Push(Boolean(ByteCmp(Pop(), w, FetchB()) < 0));
  1507.           break;
  1508.         default:
  1509.           XeqError(XNOTIMP);
  1510.         }
  1511.       break;
  1512.       
  1513.     case GEQ:
  1514.       switch(FetchUB())
  1515.         {
  1516.         case 2:
  1517.           f=PopReal(); Push(Boolean( PopReal() >= f ));
  1518.           break;
  1519.         case 4:
  1520.           w=Pop(); Push(Boolean(StrCmp(Pop(), w) >= 0) );
  1521.           break;
  1522.         case 6:
  1523.           w=Pop()&1; Push(Boolean((Pop()&1) >= w));
  1524.           break;
  1525.         case 8:
  1526.           {
  1527.         Set_t Set1;
  1528.         Set_t Set2;
  1529.         SetPop(&Set1);
  1530.         SetPop(&Set2);
  1531.         Push(Boolean(SetIsSubset(&Set2, &Set1)));
  1532.         break;
  1533.           }
  1534.           break;
  1535.         case 10:
  1536.           w=Pop(); Push(Boolean(ByteCmp(Pop(), w, FetchB()) >= 0));
  1537.           break;
  1538.         default:
  1539.           XeqError(XNOTIMP);
  1540.         }
  1541.       break;
  1542.  
  1543.     case GRT:
  1544.       switch(FetchUB())
  1545.         {
  1546.         case 2:
  1547.           f=PopReal(); Push(Boolean( PopReal() > f ));
  1548.           break;
  1549.         case 4:
  1550.           w=Pop(); Push(Boolean(StrCmp(Pop(), w) > 0) );
  1551.           break;
  1552.         case 6:
  1553.           w=Pop()&1; Push(Boolean((Pop()&1) > w));
  1554.           break;
  1555.         case 10:
  1556.           w=Pop(); Push(Boolean(ByteCmp(Pop(), w, FetchB()) > 0));
  1557.           break;
  1558.         default:
  1559.           XeqError(XNOTIMP);
  1560.         }
  1561.       break;
  1562.                 /* TOS arithmetic: logical */
  1563.     case LAND:
  1564.       Push( Pop() & Pop() );
  1565.       break;
  1566.     case LOR:
  1567.       Push( Pop() | Pop() );
  1568.       break;
  1569.     case LNOT:
  1570.       Push( ~Pop() );
  1571.       break;
  1572.                 /* Sets */
  1573.     case ADJ:
  1574.       p1=FetchUB();
  1575.       w=MemRd(Sp);
  1576.       if (p1!=w)
  1577.         {
  1578.           Set_t Buf;
  1579.           SetPop(&Buf);
  1580.           SetAdj(&Buf, p1);
  1581.           SetPush(&Buf);
  1582.         }
  1583.       if (p1!=Pop())
  1584.         panic("adj failure");
  1585.       break;
  1586.     case SGS:
  1587.       w=Pop();
  1588.       if (w<512)
  1589.         {
  1590.           int    Size=(w+16)/16;
  1591.           word    Addr;
  1592.           int    i;
  1593.           for (i=0;i<Size;i++)
  1594.         Push(0);
  1595.           Addr=WordIndexed(Sp, w/16);
  1596.           MemWr(Addr, MemRd(Addr)|(1<<w%16));
  1597.           Push(Size);
  1598.         }
  1599.       else
  1600.         XeqError(XINVNDX);
  1601.       break;
  1602.     case SRS:
  1603.       p1=Pop();
  1604.       p2=Pop();
  1605.       if ((p1<512) && (p1<512) )
  1606.         {
  1607.           if (p2>p1)
  1608.         Push(0);
  1609.           else
  1610.         {
  1611.           int    Size=(p1+16)/16;
  1612.           word    Addr;
  1613.           int    i;
  1614.           for (i=0;i<Size;i++)
  1615.             Push(0);
  1616.           while (p2<=p1)
  1617.             {
  1618.               Addr=WordIndexed(Sp, p2/16);
  1619.               MemWr(Addr, MemRd(Addr)|(1<<p2%16));
  1620.               p2++;
  1621.             }
  1622.           Push(Size);
  1623.         }
  1624.         }
  1625.       else
  1626.         XeqError(XINVNDX);
  1627.       break;
  1628.     case INN:
  1629.       {
  1630.         word Size;
  1631.         word Addr;
  1632.         word Val;
  1633.         Size=Pop();
  1634.         Addr=Sp;
  1635.         Sp=WordIndexed(Sp,Size);
  1636.         Val=Pop();
  1637.         if (Val>=16*Size)
  1638.           Push(Boolean(0));
  1639.         else
  1640.           Push(Boolean(MemRd(WordIndexed(Addr,(Val/16))) &
  1641.                (1<<(Val%16))));
  1642.       }
  1643.       break;
  1644.     case UNI:
  1645.       {
  1646.         int   i;
  1647.         word  Size;
  1648.         Set_t Set;
  1649.         
  1650.         SetPop(&Set);
  1651.         Size=Pop();
  1652.         if (Size>Set.Size)
  1653.           SetAdj(&Set, Size);
  1654.         
  1655.         for (i=0; i<Size; i++)
  1656.           Set.Data[i]|=Pop();
  1657.         SetPush(&Set);
  1658.       }
  1659.       break;
  1660.     case INT:
  1661.       {
  1662.         int   i;
  1663.         word  Size;
  1664.         Set_t Set;
  1665.         
  1666.         SetPop(&Set);
  1667.         Size=Pop();
  1668.         if (Size>Set.Size)
  1669.           SetAdj(&Set, Size);
  1670.         
  1671.         for (i=0; i<Size; i++)
  1672.           Set.Data[i]&=Pop();
  1673.         while(i<Set.Size)
  1674.           Set.Data[i++]=0;
  1675.         SetPush(&Set);
  1676.       }
  1677.       break;
  1678.  
  1679.     case DIF:
  1680.       {
  1681.         int   i;
  1682.         word  Size;
  1683.         Set_t Set;
  1684.         
  1685.         SetPop(&Set);
  1686.         Size=Pop();
  1687.         if (Size>Set.Size)
  1688.           SetAdj(&Set, Size);
  1689.         
  1690.         for (i=0; i<Size; i++)
  1691.           Set.Data[i] = Pop() & ~Set.Data[i];
  1692.         while (i<Set.Size)
  1693.           Set.Data[i]=0;
  1694.         SetPush(&Set);
  1695.       }
  1696.       break;
  1697.                 /* jumps */
  1698.     case UJP:
  1699.       w=jump((signed char)FetchUB());
  1700.       if ( ( Ipc-w == 5 ) &&        /* check for endless loop */
  1701.            ( MemRdByte(IpcBase, w  ) == SLDC_1 ) &&
  1702.            ( MemRdByte(IpcBase, w+1) == FJP    ) &&
  1703.            ( MemRdByte(IpcBase, w+2) == 2      ) )
  1704.         sleep(1);                /* reduce processor load */
  1705.       Ipc=w;
  1706.       break;
  1707.     case FJP:
  1708.       p1=FetchUB();
  1709.       if (! (Pop()&1) )
  1710.         {
  1711.           w=jump((signed char)p1);
  1712.           if ( ( Ipc-w == 3 ) &&        /* check for endless loop */
  1713.            ( MemRdByte(IpcBase, w  ) == SLDC_0 ) )
  1714.         sleep(1);            /* reduce processor load */
  1715.           Ipc=w;
  1716.         }
  1717.       break;
  1718.     case EFJ:
  1719.       p1=FetchUB();
  1720.       if ( Pop() != Pop() )
  1721.         Ipc=jump((signed char)p1);
  1722.       break;
  1723.     case NFJ:
  1724.       p1=FetchUB();
  1725.       if ( Pop() == Pop() )
  1726.         Ipc=jump((signed char)p1);
  1727.       break;
  1728.     case XJP:
  1729.       Ipc=(Ipc+1)&(~1);
  1730.       p1=FetchW(); p2=FetchW();
  1731.       w=Pop();
  1732.       if ( (w>=p1) && (w<=p2) )
  1733.         {
  1734.           Ipc=Ipc+2*(w-p1)+2;
  1735.           Ipc-=MemRd( WordIndexed( IpcBase, Ipc/2) );
  1736.         }
  1737.       break;
  1738.                 /* procedure and function calls */
  1739.     case CLP:
  1740.       call(Seg, FetchUB(), Mp);
  1741.       break;
  1742.     case CGP:
  1743.       call(Seg, FetchUB(), Base);
  1744.       break;
  1745.     case CIP:
  1746.       p1=FetchUB();
  1747.       call(Seg, p1, StaticLink(Seg, p1));
  1748.       break;
  1749.     case CBP:
  1750.       call(Seg, FetchUB(), BaseMp);
  1751.       break;
  1752.     case CXP:
  1753.       p1=FetchUB(); p2=FetchUB();
  1754.       if (p1)            /* Nicht bei Segment 0            */
  1755.         CspLoadSegment(p1);
  1756.       w=SegDict[p1].Seg;
  1757.       if (call(w, p2, StaticLink(w, p2) ))
  1758.         CspUnloadSegment(p1);
  1759.       break;
  1760.     case RNP:
  1761.       Sp  = MemRd(WordIndexed(Mp,MS_SP));
  1762.       ret(FetchUB());
  1763.       break;
  1764.     case RBP:
  1765.       Sp  = MemRd(WordIndexed(Mp,MS_SP));
  1766.       Base=Pop();
  1767.       MemWr(STKBASE, Base);
  1768.       if ( (Base<Kp) || (Base>BaseMp))
  1769.         panic("RBP: Base %04x out of range", Base);
  1770.       ret(FetchUB());
  1771.       break;
  1772.  
  1773.     case CSP:        /* CSP, Call Standard Procedure */
  1774.       switch(FetchUB())
  1775.         {
  1776.         case CSP_IOC:
  1777.           if (MemRd(IORSLT))
  1778.         XeqError(XUIOERR);
  1779.           break;
  1780.         case CSP_NEW:
  1781.           ClrGDirP();
  1782.           w=Pop();
  1783.           MemWr(Pop(),Np);
  1784.           Np=WordIndexed(Np, w);
  1785.           StackCheck();
  1786.           break;
  1787.         case CSP_MVL:
  1788.           {
  1789.         word    Len       = Pop();
  1790.         Integer DstOffset = PopInteger();
  1791.         word    Dst       = Pop();
  1792.         Integer SrcOffset = PopInteger();
  1793.         word    Src       = Pop();
  1794.         MoveLeft(Dst, DstOffset, Src, SrcOffset, Len);
  1795.           }
  1796.           break;
  1797.         case CSP_MVR:
  1798.           {
  1799.         word    Len       = Pop();
  1800.         Integer DstOffset = PopInteger();
  1801.         word    Dst       = Pop();
  1802.         Integer SrcOffset = PopInteger();
  1803.         word    Src       = Pop();
  1804.         MoveRight(Dst, DstOffset, Src, SrcOffset, Len);
  1805.           }
  1806.           break;
  1807.         case CSP_XIT:
  1808.           {
  1809.         word    ProcNo=Pop();
  1810.         word    SegNo=Pop();
  1811.         word    xMp=Mp;
  1812.         word    xSeg=Seg;
  1813.         word    xJTab=JTab;
  1814.         
  1815.         Ipc=ProcExitIpc(xJTab);
  1816.         while ( (ProcNumber(xJTab) != ProcNo) ||
  1817.             (SegNumber(xSeg)   != SegNo) )
  1818.           {
  1819.             if (!xMp ||
  1820.             !(xJTab = MemRd(WordIndexed(xMp, MS_JTAB))) ||
  1821.             !(xSeg  = MemRd(WordIndexed(xMp, MS_SEG))) )
  1822.               XeqError(XNOEXIT);
  1823.             
  1824.             MemWr(WordIndexed(xMp, MS_IPC), ProcExitIpc(xJTab));
  1825.             xMp   = MemRd(WordIndexed(xMp, MS_DYN));
  1826.           }
  1827.           }
  1828.           break;
  1829.         case CSP_UREAD:
  1830.           {
  1831.         word p1, p2, p3, p4, p5, p6;
  1832.         p6=Pop();p5=Pop();p4=Pop();
  1833.         p3=Pop();p2=Pop();p1=Pop();
  1834.         UnitRead(p1,p2,p3,p4,p5,p6);
  1835.           }
  1836.           break;
  1837.         case CSP_UWRITE:
  1838.           {
  1839.         word p1, p2, p3, p4, p5, p6;
  1840.         p6=Pop();p5=Pop();p4=Pop();
  1841.         p3=Pop();p2=Pop();p1=Pop();
  1842.         UnitWrite(p1,p2,p3,p4,p5,p6);
  1843.           }
  1844.           break;
  1845.         case CSP_TIM:
  1846.           {
  1847.         struct timeval tv;
  1848.         if (gettimeofday(&tv, NULL) <0)
  1849.           {
  1850.             perror("gettimeofday");
  1851.             MemWr(Pop(),0);
  1852.             MemWr(Pop(),0);
  1853.             MemWr( LOWTIME,  0 );
  1854.             MemWr( HIGHTIME, 0 );
  1855.           }
  1856.         else
  1857.           {
  1858.             tv.tv_sec = (tv.tv_usec*60*TIME_SCALE/1000000) 
  1859.               + tv.tv_sec*60*TIME_SCALE;
  1860.             MemWr( Pop(),    (tv.tv_sec>> 0)&0xffff );
  1861.             MemWr( LOWTIME,  (tv.tv_sec>> 0)&0xffff );
  1862.  
  1863.             MemWr( Pop(),    (tv.tv_sec>>16)&0xffff );
  1864.             MemWr( HIGHTIME, (tv.tv_sec>>16)&0xffff );
  1865.           }
  1866.           }
  1867.           break;
  1868. #ifdef CSP_IDS
  1869.         case CSP_IDS:
  1870.           {
  1871.         word    BufPtr    = Pop();
  1872.         word    Arg2Ptr   = Pop();
  1873.         CspIdSearch(BufPtr, Arg2Ptr);
  1874.           }
  1875.           break;
  1876. #endif
  1877. #ifdef CSP_TRS
  1878.         case CSP_TRS:
  1879.           {
  1880.         word TokenBuf  = Pop();
  1881.         word ResultPtr = Pop();
  1882.         word NodePtr   = Pop();    /* initialize with root node addr   */
  1883.         Push(CspTreeSearch(TokenBuf, ResultPtr, NodePtr));
  1884.           }
  1885.           break;
  1886. #endif
  1887.         case CSP_FLC:
  1888.           {
  1889.         word    ch     = Pop();
  1890.         word    Len    = Pop();
  1891.         Integer Offset = PopInteger();
  1892.         word    Addr   = Pop();
  1893.         if (!(Len&0x8000))
  1894.           while (Len--)
  1895.             MemWrByte(Addr, Offset++, ch);
  1896.           }
  1897.           break;
  1898.         case CSP_SCN:
  1899.           {
  1900.         word    Dummy  = Pop();
  1901.         Integer    Offset = PopInteger();
  1902.         word    Buf    = Pop();        /* Buffer Address */
  1903.         word    ch     = Pop();        /* zu suchendes Zeichen */
  1904.         word    match  = Pop();        /* 0 suche nach ==ch,
  1905.                            !=0: Suche nach !=ch */
  1906.         word    limit  = Pop();        /* Limit */
  1907.         word    res;
  1908.         
  1909.         if (limit&0x8000)
  1910.           {
  1911.             limit=0x10000-limit;
  1912.             for (res=0; res<limit; res++)
  1913.               if (MemRdByte(Buf, Offset-res)!=ch)
  1914.             { if (match) break; }
  1915.               else
  1916.             { if (!match) break; }
  1917.             Push(0x10000-res);
  1918.           }
  1919.         else
  1920.           {
  1921.             for (res=0; res<limit; res++)
  1922.               if (MemRdByte(Buf, Offset+res)!=ch)
  1923.             { if (match) break; }
  1924.               else
  1925.             { if (!match) break; }
  1926.             Push(res);
  1927.           }
  1928.           }
  1929.           break;
  1930.         case CSP_USTAT:
  1931.           {
  1932.         word    Dummy  = Pop();
  1933.         Integer Offset = PopInteger();
  1934.         word    Addr   = Pop();
  1935.         word    Unit   = Pop();
  1936.         UnitStat(Unit, Addr, Offset, Dummy);
  1937.           }
  1938.           break;
  1939. #ifdef CSP_LDSEG
  1940.         case CSP_LDSEG:
  1941.           CspLoadSegment(Pop());
  1942.           break;
  1943. #endif
  1944. #ifdef CSP_ULDSEG
  1945.         case CSP_ULDSEG:
  1946.           CspUnloadSegment(Pop());
  1947.           break;
  1948. #endif
  1949.         case CSP_TRC:
  1950.           f=PopReal();
  1951.           if (f<0)
  1952.         Push(ceil(f));
  1953.           else
  1954.         Push(floor(f));
  1955.           break;
  1956.         case CSP_RND:
  1957.           Push(rint(PopReal()));
  1958.           break;
  1959.         case CSP_MRK:
  1960.           ClrGDirP();
  1961.           MemWr(Pop(),Np);
  1962.           break;
  1963.         case CSP_RLS:
  1964.           Np=MemRd(Pop());
  1965.           StackCheck();
  1966.           MemWr(GDIRP, NIL);
  1967.           break;
  1968.         case CSP_IOR:
  1969.           Push(MemRd(IORSLT));
  1970.           break;
  1971.         case CSP_UBUSY:
  1972.           Push(UnitBusy(Pop()));
  1973.           break;
  1974.         case CSP_POT:
  1975.           {
  1976.         float PwrOfTen[]={1e0,  1e1,  1e2,  1e3,  1e4,  1e5,
  1977.                   1e6,  1e7,  1e8,  1e9,  1e10, 1e11,
  1978.                   1e12, 1e13, 1e14, 1e15, 1e16, 1e17,
  1979.                   1e18, 1e19, 1e20, 1e21, 1e22, 1e23,
  1980.                   1e24, 1e25, 1e26, 1e27, 1e28, 1e29,
  1981.                   1e30, 1e31, 1e32, 1e33, 1e34, 1e35,
  1982.                   1e36, 1e37, 1e38, 1e39};
  1983.         int Value=PopInteger();
  1984.         if ( (Value<0) || (Value>39) )
  1985.           PushReal(0);/* WWW: XeqError(XINVNDX); */
  1986.         else
  1987.           PushReal(PwrOfTen[Value]);
  1988.           }
  1989.           break;
  1990.         case CSP_UWAIT:
  1991.           UnitWait(Pop());
  1992.           break;
  1993.         case CSP_UCLEAR:
  1994.           UnitClear(Pop());
  1995.           break;
  1996.         case CSP_HLT:
  1997.           return;
  1998.           break;
  1999.         case CSP_MAV:
  2000.           if (MemRd(GDIRP))
  2001.         w=Kp-MemRd(GDIRP);
  2002.           else
  2003.         w=Kp-Np;
  2004.           Push(w/2);
  2005.           break;
  2006.         default:
  2007.           XeqError(XNOTIMP);
  2008.         }
  2009.       break;
  2010.  
  2011.     case BPT:
  2012.       p1 = FetchB();
  2013.       if ( (MemRd(BUGSTATE)>=3) ||
  2014.            (p1 == MemRd(BRKPTS0)) ||
  2015.            (p1 == MemRd(BRKPTS1)) ||
  2016.            (p1 == MemRd(BRKPTS2)) ||
  2017.            (p1 == MemRd(BRKPTS3)) )
  2018.         XeqError(XBRKPNT);
  2019.       break;
  2020.     case XIT:
  2021.       return;
  2022.       XeqError(XHLTBPT);
  2023.       break;
  2024.     case NOP:
  2025.       break;
  2026.     default:
  2027.       XeqError(XNOTIMP);
  2028.       break;
  2029.     }
  2030.     }
  2031. }
  2032.  
  2033. word LookupFile(word Unit, const char *Name)
  2034. {
  2035.   int i;
  2036.   DiskRead(Unit, Np, 0, 2048, 2);
  2037.   if (MemRd(IORSLT))
  2038.     return(0);
  2039.  
  2040.   for (i=0;i<MemRd(WordIndexed(Np, 8));i++)
  2041.     {
  2042.       word Entry=WordIndexed(Np, 13+13*i);
  2043.       int len;
  2044.       for (len=0; len<MemRdByte(WordIndexed(Entry, 3),0); len++)
  2045.     if (toupper(MemRdByte(WordIndexed(Entry, 3),1+len)) !=
  2046.         toupper(Name[len]))
  2047.       goto next;
  2048.       if (Name[len])
  2049.     continue;
  2050.       return(MemRd(WordIndexed(Entry,0)));
  2051.     next:
  2052.       ;
  2053.     }
  2054.   return(0);
  2055. }
  2056.  
  2057. /* Das Segment 0 ist aufgespalten, und die Zeiger im
  2058.    Procedure-Dictionary sind so korrigiert worden, dass nach dem Laden
  2059.    der beiden Hälften an die jeweils "richtige" Addresse die Zeiger
  2060.    korrekt sind.
  2061.  
  2062.    Diese Routine korrigiert die Zeiger im Segment-Dictionary. Dazu
  2063.    ermittelt sie zuerst die Addresse, an der die zwiete hälfte
  2064.    eigentlich geladen werden sollte. Danach wird ein Offset ermittelt,
  2065.    mit dem die Zeiger in die zweite Hälfte korrigiert werden müssen. */
  2066.  
  2067. static void FixupSeg0(word LoadAddr)
  2068. {
  2069.   word Seg=SegDict[0].Seg;
  2070.   word SegBase=SegDict[0].SegBase;
  2071.   word Addr;
  2072.   word Offset;
  2073.   int i;
  2074.  
  2075.   Addr=0;
  2076.   for (i=1;i<=SegNumProc(Seg); i++)
  2077.     {
  2078.       word JTab=Proc(Seg, i);
  2079.       if (JTab<SegBase)
  2080.     if (JTab>Addr)
  2081.       Addr=JTab;
  2082.     }
  2083.   if (!Addr)
  2084.     return;            /* no Fixup needed */
  2085.   Addr=WordIndexed(Addr,1);
  2086.   Offset=LoadAddr-Addr;
  2087.   if (!Offset)
  2088.     return;
  2089.  
  2090.   for (i=1;i<=SegNumProc(Seg); i++)
  2091.     {
  2092.       word JTab=Proc(Seg, i);
  2093.       if ( (JTab<SegBase) )
  2094.     {
  2095.       Addr=WordIndexed(Seg,-i);
  2096. #ifdef WORD_MEMORY
  2097.       MemWr(Addr, MemRd(Addr)-2*Offset);
  2098. #else
  2099.       MemWr(Addr, MemRd(Addr)-Offset);
  2100. #endif
  2101.     }
  2102.     }
  2103. }
  2104.  
  2105. static void load(word Unit, word BlockNo)
  2106. {
  2107.   int    i;
  2108.  
  2109.   DiskRead(Unit, Np, 0, 512, BlockNo);
  2110.   if (MemRd(IORSLT))
  2111.     return;
  2112.  
  2113.   /* Erzeuge das Segment Dictionary */
  2114.   for (i=0;i<16;i++)
  2115.     {
  2116.       word    CodeAddr=MemRd(WordIndexed(Np, 2*i))+BlockNo;
  2117.       word    CodeLeng=MemRd(WordIndexed(Np, 2*i+1));
  2118.       word    SegInfo =MemRd(WordIndexed(Np, i+0x80));
  2119.  
  2120.       assert (!(CodeLeng&1));
  2121.  
  2122.       if (CodeAddr && CodeLeng)
  2123.     {
  2124.       int    SegNo=SegInfo&0xff;
  2125.       if (SegInfo&0x0f00)
  2126.         {
  2127.           MemWr(SEG_UNIT(SegNo),  Unit);
  2128.           MemWr(SEG_BLOCK(SegNo), CodeAddr);
  2129.           MemWr(SEG_SIZE(SegNo),  CodeLeng);
  2130.         }
  2131.       if (SegNo==0)
  2132.         {
  2133.           if (!SegDict[0].UseCount)
  2134.         {
  2135.           SegDict[0].UseCount++;
  2136.           SegDict[0].OldKp=Kp;
  2137.           SegDict[0].Seg=WordIndexed(Kp,-1);
  2138. #ifdef WORD_MEMORY
  2139.           Kp-=CodeLeng/2;
  2140. #else
  2141.           Kp-=CodeLeng;
  2142. #endif
  2143.           SegDict[0].SegBase=Kp;
  2144.           DiskRead(Unit, Kp, 0, CodeLeng, CodeAddr);
  2145.         }
  2146.           else
  2147.         {
  2148. #ifndef WORD_MEMORY
  2149. #ifdef APPLE_SEG0_LOAD_GAP
  2150.           if (AppleCompatibility)
  2151.             {
  2152.               Kp-=APPLE_SEG0_LOAD_GAP;
  2153.               assert (Syscom>=Kp );
  2154.               assert (WordIndexed(Syscom, SYSCOM_SIZE) <
  2155.                   Kp+APPLE_SEG0_LOAD_GAP );
  2156.             }
  2157. #endif
  2158. #endif
  2159.           FixupSeg0(Kp);
  2160. #ifdef WORD_MEMORY
  2161.           Kp-=CodeLeng/2;
  2162. #else
  2163.           Kp-=CodeLeng;
  2164. #endif
  2165.           DiskRead(Unit, Kp, 0, CodeLeng, CodeAddr);
  2166.         }
  2167.         }
  2168.     }
  2169.     }
  2170. }
  2171.  
  2172. void LoadSystem(int RootUnit, const char *FileName)
  2173. {
  2174.   int    Unit=0;
  2175.   int    Block;
  2176.  
  2177.   if ((Block=LookupFile(RootUnit, FileName)))
  2178.     Unit=RootUnit;
  2179.   else
  2180.     for (Unit=4; Unit<MAX_UNIT; Unit++)
  2181.       {
  2182.     if (Unit==6)
  2183.       Unit=9;
  2184.     if ((Block=LookupFile(Unit, FileName)))
  2185.       break;
  2186.       }
  2187.   if (!Block || !Unit)
  2188.     panic("%s: not found", FileName );
  2189.  
  2190.   load(Unit, Block);
  2191.   if (MemRd(IORSLT))
  2192.     panic("$s unit %d block %d: Ioerror %d",
  2193.       FileName, Unit, Block, MemRd(IORSLT));
  2194.   if (!SegDict[0].UseCount)
  2195.     panic("%s: not a valid system, no segment 0", FileName );
  2196.  
  2197.   call(SegDict[0].Seg, 1, NIL);
  2198. }
  2199.  
  2200. int main (int argc, char *argv[])
  2201. {
  2202.   int        i;
  2203.   int        Unit=4;
  2204.   int        UseXTerm=0;
  2205.   int        BatchFd=-1;
  2206.   const char    *SystemName="system.pascal";
  2207.  
  2208.   memset(SegDict, 0, sizeof(SegDict));
  2209.   MemInit();
  2210.   DiskInit();
  2211.   TraceProc=0;
  2212.   TraceSeg=1;
  2213.  
  2214.   while ((i=getopt(argc, argv, 
  2215. #ifndef WORD_MEMORY
  2216.            "a"
  2217. #endif
  2218.            "b:gn:t:T:w:r:f:xV"))!=EOF)
  2219.     switch(i)
  2220.       {
  2221. #ifndef WORD_MEMORY
  2222.       case 'a':
  2223.     AppleCompatibility=1;
  2224.     break;
  2225. #endif
  2226.       case 'b':
  2227.     if (!optarg || !*optarg)
  2228.       {
  2229.         fprintf(stderr,"-b option requires filename argument or '-' for stdin\n");
  2230.         exit(1);
  2231.       }
  2232.     if (strcmp(optarg, "-")==0)
  2233.       BatchFd=0;
  2234.     else
  2235.       if ((BatchFd=open(optarg, O_RDONLY))<0)
  2236.         {
  2237.           perror(optarg);
  2238.           exit(1);
  2239.         }
  2240.     break;
  2241.  
  2242.       case 'g':
  2243.     TraceLevel=0x7fff;
  2244.     break;
  2245.       case 'n':
  2246.     if (!optarg || !*optarg)
  2247.       {
  2248.         fprintf(stderr,"-n option requires filename argument or '-' for stdout\n");
  2249.         exit(1);
  2250.       }
  2251.     SystemName=optarg;
  2252.     break;
  2253.       case 't':
  2254.     if (!optarg || !*optarg)
  2255.       {
  2256.         fprintf(stderr,"-t option requires filename argument\n");
  2257.         exit(1);
  2258.       }
  2259.     if (strcmp(optarg,"-")==0)
  2260.       TraceFile=fdopen(dup(1), "w");
  2261.     else 
  2262.       {
  2263.         if (!(TraceFile=fopen(optarg,"w")))
  2264.           {
  2265.         perror(optarg);
  2266.         exit(1);
  2267.           }
  2268.       }
  2269.     break;
  2270.       case 'T':
  2271.     SetTrace(optarg);
  2272.     break;
  2273.  
  2274.       case 'w':
  2275.       case 'r':
  2276.       case 'f':
  2277.     {
  2278.       enum DiskMode Mode;
  2279.       switch(i)
  2280.         {
  2281.         case 'w':    Mode=ReadWrite;    break;
  2282.         case 'r':    Mode=ReadOnly;    break;
  2283.         case 'f':    Mode=Forget;    break;
  2284.         }
  2285.       if (!optarg || !*optarg)
  2286.         {
  2287.           fprintf(stderr,"-%c option requires filename argument\n", i);
  2288.           exit(1);
  2289.         }
  2290.       if (DiskMount(Unit, optarg, Mode)<0)
  2291.         exit(1);
  2292.       Unit++;
  2293.       if (Unit==6) Unit=9;
  2294.     }
  2295.     break;
  2296.       case 'x':
  2297.     UseXTerm++;
  2298.     break;
  2299.       case 'V':
  2300.     fprintf(stderr, "%s, a UCSD p-code interperter version %s\n", argv[0], VERSION);
  2301.     fprintf(stderr, "For updated versions check http://www.klebsch.de/.\n");
  2302.     exit(0);
  2303.     break;
  2304.       }
  2305.  
  2306.   TermOpen(UseXTerm, BatchFd);
  2307.     
  2308. #ifndef WORD_MEMORY
  2309.   if (AppleCompatibility)
  2310.     {
  2311.       Np=APPLE_HEAP_BOT;
  2312.       Kp=APPLE_KP_TOP;
  2313.       Syscom=APPLE_SYSCOM;
  2314.     }
  2315.   else
  2316. #endif
  2317.     {
  2318.       Np=HEAP_BOT;
  2319.       Kp=KP_TOP;
  2320.       Kp=WordIndexed(Kp, -SYSCOM_SIZE);
  2321.       Syscom=Kp;
  2322.     }
  2323.   Sp=SP_TOP;
  2324.   Mp=Kp;
  2325.  
  2326.   LoadSystem(4, SystemName);
  2327.   BaseMp=Mp;
  2328.   Sp=WordIndexed(Sp,1);            /* SP korrigieren */
  2329.  
  2330.   MemWr( LocalAddr(1), Syscom );
  2331.   MemWr( GDIRP  , NIL );
  2332.   MemWr( SYSUNIT, 4 );
  2333.  
  2334. #ifndef WORD_MEMORY
  2335.   if (AppleCompatibility)
  2336.     {
  2337.       MemWr( WordIndexed(Syscom,161), 0x4bd);
  2338.       MemWr( WordIndexed(Syscom,166), 0x6);
  2339.       MemWrByte( WordIndexed(Syscom,169), 1, 0x81);/* Bitfeld mit
  2340.     }                              unbekanntem Inhalt */
  2341. #endif
  2342.  
  2343.   Processor();
  2344.  
  2345.   DumpCore();
  2346.   if (TraceFile)
  2347.     fclose(TraceFile);
  2348.  
  2349.   while (Unit>4)
  2350.     {
  2351.       Unit--;
  2352.       if (Unit==8)
  2353.     Unit=5;
  2354.       DiskUmount(Unit);
  2355.     }
  2356.   TermClose();
  2357.   return(0);
  2358. }
  2359.